;; This time, target is a polynomial
(defparameter *target* #(1.0 -1.5 1.24 -3.6 -4.2 1.8 -2.7 5.6))
(defparameter *mutation-rate* 0.05)
(defparameter *mutation-step-size* 0.1
  "How much difference one mutation can make")

(defun pretty-print-polynomial (polynomial)
  "Print a prettified version of a polynomial array"
  (format t "~A*x**7 + ~A*x**6 + ~A*x**5 + ~A*x**4 + ~A*x**3 + ~A*x**2 + ~A*x + ~A"
	  (elt polynomial 0)
	  (elt polynomial 1)
	  (elt polynomial 2)
	  (elt polynomial 3)
	  (elt polynomial 4)
	  (elt polynomial 5)
	  (elt polynomial 6)
	  (elt polynomial 7)))

(defun eval-polynomial (polynomial x)
  "Evaluate a polynomial at x"
  (loop for index across polynomial
	do (setf running-sum (* running-sum x))
	sum index into running-sum
	finally (return running-sum)))

(defun fitness (x)
  "Calculate the fitness. In this case, since we're using least-squares, a
   smaller fitness is better."
  (loop for test-number from -1.0 to 1.0 by 0.1
	sum (expt (- (eval-polynomial *target* test-number)
		     (eval-polynomial x test-number))
		  2.0)))

(defun probability (p)
 "Return true with a probability p"
 (<= 0
     (random 1.0)
     p))

(defun mutate (x &optional (mutation-rate *mutation-rate*))
 "Destructively modify coefficients in  x"
 (dotimes (index (length x))
   (if (probability mutation-rate)
       (incf (elt x index) (- (random (* 2.0 *mutation-step-size*))
			      *mutation-step-size*))))
 x)

(defparameter *gene-pool-size* 20)
(defparameter *gene-pool* (make-array *gene-pool-size*
                                     :element-type '(simple-array single-float (8))
                                     :initial-element #(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)
                                     :fill-pointer nil
                                     :adjustable nil))

(defun fill-gene-pool (&optional (candidate
				  #(0.0 0.0 0.0 0.0 0.0 0.0 0.0 0.0)))
 "Fill the gene pool with mutated versions of a given polynomial, which
  defaults to all 0.0 coefficients"
 (dotimes (index (length *gene-pool*))
   (setf (elt *gene-pool* index)
         (mutate (copy-seq candidate)))))

(defun best-of-gene-pool ()
 "Return the best candidate in the gene pool"
 (let ((best (elt *gene-pool* 0)))
   (loop for candidate across *gene-pool*
         do (when (< (fitness candidate)
                     (fitness best))
              (setf best candidate)))
   best))

(defun evolve (generations)
 (dotimes (current-generation generations)
   (fill-gene-pool (best-of-gene-pool))))